home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / libs / x / xvada-0.4 / xvada-0 / xvAda-0.4.1 / xv_textsw_package.adb < prev    next >
Encoding:
Text File  |  1996-05-19  |  15.7 KB  |  447 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                        XVIEW ADA LIBRARY COMPONENTS                      --
  4. --                                                                          --
  5. --                            XVIEW_TEXTSW_PACKAGE                          --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --          Copyright (c) 1995 Andreas Almroth, All Rights Reserved         --
  10. --                                                                          --
  11. -- The  XVIEW ADA  library is free software; you can redistribute it and/or --
  12. -- modify  it  under terms of the  GNU  Library General  Public  License as --
  13. -- published by the Free Software Foundation; either version 2, or (at your --
  14. -- option) any later version. The XVIEW ADA library is  distributed  in the --
  15. -- hope that it will be useful,  but WITHOUT ANY WARRANTY; without even the --
  16. -- implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
  17. -- See the GNU Library General Public License for more details.             --
  18. -- You should have  received  a  copy of the  GNU  Library  General  Public --
  19. -- License along with the XVIEW ADA library; see the file  COPYING.LIB.  If --
  20. -- not, write to the Free  Software  Foundation, 675  Mass  Ave, Cambridge, --
  21. -- MA 02139, USA.                                                           --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. -- Lots of bindings to XView C functions needs the Interfaces.C package.
  26.  
  27. with Interfaces.C,Interfaces.C.Strings;
  28.  
  29. package body Xv_Textsw_Package is
  30.  
  31.   XV_SHOW         : constant := 1079052545;
  32.   XV_WIDTH        : constant := 1246234689;
  33.   XV_HEIGHT       : constant := 1246300289;
  34.   XV_X            : constant := 1246103617;
  35.   XV_Y            : constant := 1246169217;
  36.  
  37.   TEXTSW_FILE     : constant := 1461717345;
  38.   TEXTSW_LENGTH   : constant := 1463158785;
  39.   TEXTSW_FONT     : constant := 1245710849;
  40.   TEXTSW_STATUS   : constant := 1464338945;
  41.   TEXTSW_FIRST    : constant := 1462241281;
  42.   TEXTSW_MODIFIED : constant := 1463683329;
  43.   TEXTSW_INSERTION_POINT : constant := 1462765569;
  44.  
  45.   TEXTSW_UNIT_IS_CHAR : constant := 1073741825;
  46.   TEXTSW_UNIT_IS_WORD : constant := 1073741826;
  47.   TEXTSW_UNIT_IS_LINE : constant := 1073742081;
  48.   TEXTSW_FILE_CONTENTS : constant := 1461979489;
  49.   TEXTSW_CONTENTS : constant := 1460799841;
  50.   TEXTSW_INSERT_FROM_FILE : constant := 1462896993;
  51.   TEXTSW_LINE_BREAK_ACTION : constant := 1463290145;
  52.  
  53.   Status : aliased Integer;
  54.   Top_Value : aliased Integer;
  55.   Bottom_Value : aliased Integer;
  56.   Start_Value : aliased Integer;
  57.   Finish_Value : aliased Integer;
  58.  
  59. -----------------------------------------------------------------------------
  60.  
  61.   function xv_set (owner : Xv_opaque; cmd : Integer; 
  62.                    data : Integer; term : Integer) return Xv_object;
  63.     pragma import (C,xv_set,"xv_set");
  64.  
  65.   function xv_set (owner : Xv_opaque; cmd : Integer; 
  66.            data1: Int_Ptr;
  67.            cmd2 : Integer; data2 : Interfaces.C.char_array; 
  68.            Cmd3 : Integer; Data3 : Integer;
  69.                    term : Integer) return Xv_object;
  70.     pragma import (C,xv_set,"xv_set");
  71.  
  72.   function xv_set (owner : Xv_opaque; cmd : Integer; 
  73.            data1: Int_Ptr; data2 : Interfaces.C.char_array; 
  74.                    term : Integer) return Xv_object;
  75.     pragma import (C,xv_set,"xv_set");
  76.  
  77.   function xv_set (owner : Xv_opaque; cmd : Integer; 
  78.            data2 : Interfaces.C.char_array; 
  79.            Data3 : Integer; term : Integer) return Xv_object;
  80.     pragma import (C,xv_set,"xv_set");
  81.  
  82.   function xv_set (owner : Xv_Opaque; Cmd : Integer; 
  83.                    Func : Callback_Textsw_Ptr;
  84.                    Term : Integer) return Xv_object;
  85.     pragma import (C,xv_set,"xv_set");
  86.  
  87. -----------------------------------------------------------------------------
  88.  
  89.     procedure xv_destroy_safe (object : Xv_Opaque);
  90.     pragma import (C,xv_destroy_safe,"xv_destroy_safe");
  91.  
  92. -----------------------------------------------------------------------------
  93.  
  94.   function xv_get (owner : Xv_opaque; cmd : Integer; term : Integer) 
  95.                    return Integer;
  96.     pragma import (C,xv_get,"xv_get");
  97.  
  98.   function xv_get (owner : Xv_opaque; cmd : Integer; 
  99.            Data1 : Integer;
  100.            Data2 : Interfaces.C.Char_Array; Len : Integer;
  101.            term : Integer) 
  102.                    return Integer;
  103.     pragma import (C,xv_get,"xv_get");
  104.  
  105. -----------------------------------------------------------------------------
  106.  
  107.     function Textsw_Edit (Obj : Textsw; Unit, Count, Direction : Integer)
  108.               return Textsw_Index;
  109.     pragma Import (C,Textsw_Edit,"textsw_edit");
  110.  
  111. -----------------------------------------------------------------------------
  112. -----------------------------------------------------------------------------
  113. -- xv_textsw
  114. -----------------------------------------------------------------------------
  115. -----------------------------------------------------------------------------
  116.  
  117.   procedure Initialize (V : in out Xv_Textsw) is
  118.  
  119. -- Declare C binding for xv_create
  120.  
  121.     function Xv_Create (Owner : Frame; Pkg : Xv_Pkg_Ptr; Term : Integer) 
  122.             return Textsw;
  123.     pragma Import (C,Xv_Create,"xv_create");
  124.  
  125. -- Initialize panel_base pointer
  126.  
  127.     Xv_Textsw_Pkg : Xv_Pkg_Ptr;
  128.     pragma Import (C,Xv_Textsw_pkg,"my_xv_textsw_pkg");
  129.   begin
  130.      V.Base := Xv_Create(V.Parent,Xv_Textsw_pkg,0);
  131.   end Initialize;
  132.  
  133. -----------------------------------------------------------------------------
  134.  
  135.   procedure Finalize (V : in out Xv_Textsw) is
  136.   begin
  137.      Xv_Destroy_Safe(Xv_Opaque(V.Base));
  138.   end Finalize;
  139.  
  140. -----------------------------------------------------------------------------
  141.  
  142.   procedure Set_Pos (V : in Xv_Textsw; X,Y : Integer) is
  143.     Xv_Rc : Xv_Object;
  144.   begin
  145.     Xv_Rc := Xv_Set(Xv_Opaque(V.Base),XV_X,X,0);
  146.     Xv_Rc := Xv_Set(Xv_Opaque(V.Base),XV_Y,Y,0);
  147.   end Set_Pos;
  148.  
  149. -----------------------------------------------------------------------------
  150.  
  151.   procedure Set_Size (V : in Xv_Textsw; W,H : Integer) is
  152.     Xv_Rc : Xv_Object;
  153.   begin
  154.     Xv_Rc := Xv_Set(Xv_Opaque(V.base),XV_WIDTH,W,0);
  155.     Xv_Rc := Xv_Set(Xv_Opaque(V.base),XV_HEIGHT,H,0);
  156.   end Set_Size;
  157.  
  158. -----------------------------------------------------------------------------
  159.  
  160.   function Get_Textsw (V : in Xv_Textsw) return Textsw is
  161.   begin
  162.     return V.Base;
  163.   end Get_Textsw;
  164.  
  165. -----------------------------------------------------------------------------
  166.  
  167.   function Load_File (V : in Xv_Textsw; File_Name : String;
  168.              Position : Integer) return Boolean is
  169.      Xv_Rc  : Xv_Object;
  170.   begin
  171.      Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_STATUS,Status'access,
  172.              TEXTSW_FILE,Interfaces.C.To_C(File_Name,True),
  173.              TEXTSW_FIRST,Position,0);
  174.  
  175.      if Status = 0 then 
  176.     return True;
  177.      else
  178.     return False;
  179.      end if;
  180.   end Load_File;
  181.  
  182. -----------------------------------------------------------------------------
  183.  
  184.   function Save_File (V : in Xv_Textsw) return Boolean is
  185.      function Textsw_Save (Obj : Textsw; Loc_X, Loc_Y : Integer)
  186.              return Integer;
  187.      pragma Import (C,Textsw_Save,"textsw_save");
  188.  
  189.      Xv_Rc  : Integer;
  190.   begin
  191.      Xv_Rc := Textsw_Save(V.Base,0,0);
  192.  
  193.      if Xv_Rc = 0 then 
  194.     return True;
  195.      else
  196.     return False;
  197.      end if;
  198.   end Save_File;
  199.  
  200. -----------------------------------------------------------------------------
  201.  
  202.   function Store_File (V : in Xv_Textsw; File_Name : String) return Boolean is
  203.      function Textsw_Store (Obj : Textsw; Filename : Interfaces.C.Char_Array;
  204.                Loc_X, Loc_Y : Integer) return Integer;
  205.      pragma Import (C,Textsw_Store,"textsw_store_file");
  206.  
  207.      Xv_Rc  : Integer;
  208.   begin
  209.      Xv_Rc := Textsw_Store(V.Base,Interfaces.C.To_C(File_Name,True),0,0);
  210.  
  211.      if Xv_Rc = 0 then 
  212.     return True;
  213.      else
  214.     return False;
  215.      end if;
  216.   end Store_File;
  217.  
  218. -----------------------------------------------------------------------------
  219.  
  220.   procedure Discard (V : in Xv_Textsw) is
  221.      procedure Textsw_Reset (Obj : Textsw; Loc_X, Loc_Y : Integer);
  222.      pragma Import (C,Textsw_Reset,"textsw_reset");
  223.   begin
  224.      Textsw_Reset(V.Base,0,0);
  225.   end Discard;
  226.  
  227. -----------------------------------------------------------------------------
  228.  
  229.   function Is_Modified (V : in Xv_Textsw) return Boolean is
  230.      Xv_Rc  : Integer;
  231.   begin
  232.      Xv_Rc := Xv_Get(Xv_Opaque(V.Base),TEXTSW_MODIFIED,0);
  233.  
  234.      if Xv_Rc = 0 then 
  235.     return False;
  236.      else
  237.     return True;
  238.      end if;
  239.   end Is_Modified;
  240.  
  241. -----------------------------------------------------------------------------
  242.  
  243.   function Insert_Text (V : in Xv_Textsw; Txt : String) return Textsw_Index is
  244.      function Textsw_Insert (Obj : Textsw; Txt : Interfaces.C.Char_Array;
  245.                   Length : Integer) return Textsw_Index;
  246.      pragma Import (C,Textsw_Insert,"textsw_insert");
  247.   begin
  248.      return Textsw_Insert(V.Base,Interfaces.C.To_C(Txt,True),Txt'Last);
  249.   end Insert_Text;
  250.  
  251. -----------------------------------------------------------------------------
  252.  
  253.   procedure Move_Point (V : in Xv_Textsw; Position : Textsw_Index) is
  254.      procedure Textsw_Possibly_normalize (Obj : Textsw; Position : Integer);
  255.      pragma Import (C,Textsw_Possibly_Normalize,"textsw_possibly_normalize");
  256.      Xv_Rc  : Xv_Object;
  257.   begin
  258.      Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_INSERTION_POINT,
  259.              Integer(Position),0);
  260.      Textsw_Possibly_Normalize(V.Base,Integer(Position));
  261.   end Move_Point;
  262.  
  263. -----------------------------------------------------------------------------
  264.  
  265.   function Get_Point (V : in Xv_Textsw) return Textsw_Index is
  266.   begin
  267.      return Textsw_Index(Xv_Get(Xv_Opaque(V.Base),TEXTSW_INSERTION_POINT,0));
  268.   end Get_Point;
  269.  
  270. -----------------------------------------------------------------------------
  271.  
  272.   function Delete_Text (V : in Xv_Textsw; First, Last : Textsw_Index) 
  273.             return Textsw_Index is
  274.      function Textsw_Delete (Obj : Textsw; First, Last : Integer)
  275.                  return Textsw_Index;
  276.      pragma Import (C,Textsw_Delete,"textsw_delete");
  277.  
  278.   begin
  279.      return Textsw_Delete(V.Base,Integer(First),Integer(Last) + 1);
  280.   end Delete_Text;
  281.  
  282. -----------------------------------------------------------------------------
  283.  
  284.   function Delete_Char (V : in Xv_Textsw; Count, Direction : Integer) 
  285.             return Textsw_Index is
  286.   begin
  287.      return Textsw_Edit(V.Base,TEXTSW_UNIT_IS_CHAR,Count,Direction);
  288.   end Delete_Char;
  289.  
  290. -----------------------------------------------------------------------------
  291.  
  292.   function Delete_Word (V : in Xv_Textsw; Count, Direction : Integer) 
  293.             return Textsw_Index is
  294.   begin
  295.      return Textsw_Edit(V.Base,TEXTSW_UNIT_IS_WORD,Count,Direction);
  296.   end Delete_Word;
  297.  
  298. -----------------------------------------------------------------------------
  299.  
  300.   function Delete_Line (V : in Xv_Textsw; Count, Direction : Integer) 
  301.             return Textsw_Index is
  302.   begin
  303.      return Textsw_Edit(V.Base,TEXTSW_UNIT_IS_LINE,Count,Direction);
  304.   end Delete_Line;
  305.  
  306. -----------------------------------------------------------------------------
  307.  
  308.   function Replace_Text (V : in Xv_Textsw; First, Last : Textsw_Index;
  309.              Txt : String) return Textsw_Index is
  310.      function Textsw_Replace_bytes (Obj : Textsw; First, Last : Integer;
  311.                     Txt : Interfaces.C.Char_Array;
  312.                     Length : Integer) return Textsw_Index;
  313.      pragma Import (C,Textsw_Replace_Bytes,"textsw_replace_bytes");
  314.  
  315.   begin
  316.      return Textsw_Replace_Bytes(V.Base,Integer(First),Integer(Last) + 1,
  317.                  Interfaces.C.To_C(Txt,True),Txt'Last);
  318.   end Replace_Text;
  319.  
  320. -----------------------------------------------------------------------------
  321.  
  322.   function Get_Text_Size (V : in Xv_Textsw) return Textsw_Index is
  323.   begin
  324.      return Textsw_Index(Xv_Get(Xv_Opaque(V.Base),TEXTSW_LENGTH,0));
  325.   end Get_Text_Size;
  326.  
  327.  
  328. -----------------------------------------------------------------------------
  329.  
  330.   procedure Set_Font (V : in Xv_Textsw; Fnt : Font)is
  331.      Xv_Rc : Xv_Object;
  332.   begin
  333.      Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_FONT,Integer(Fnt),0);
  334.   end Set_Font;
  335.  
  336. -----------------------------------------------------------------------------
  337.  
  338.   procedure File_Contents (V : in Xv_Textsw; File_Name : String; 
  339.                Position : Integer) is
  340.      Xv_Rc : Xv_Object;
  341.   begin
  342.      Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_FILE_CONTENTS,
  343.              Interfaces.C.To_C(File_Name,True),Position,0);
  344.   end File_Contents;
  345.  
  346. -----------------------------------------------------------------------------
  347.  
  348.   procedure Contents (V : in Xv_Textsw; Txt : String; Position : Integer) is
  349.      Xv_Rc : Xv_Object;
  350.   begin
  351.      Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_CONTENTS,
  352.              Interfaces.C.To_C(Txt,True),Position,0);
  353.   end Contents;
  354.  
  355. -----------------------------------------------------------------------------
  356.  
  357.   function Get_Contents (V : in Xv_Textsw; From : Textsw_Index;
  358.              Max_Len : Integer) return String is
  359.      Xv_Rc : Integer;
  360.      Work : Interfaces.C.Char_Array(1..Interfaces.C.Size_T(Max_Len));
  361.   begin
  362.      Xv_Rc := Xv_Get(Xv_Opaque(V.Base),TEXTSW_CONTENTS,Integer(From),
  363.              Work,Max_Len + 1,0);
  364.      return Interfaces.C.To_Ada(Work);
  365.   end Get_Contents;
  366.  
  367. -----------------------------------------------------------------------------
  368.  
  369.   function Insert_File (V : in Xv_Textsw; File_Name : String) return Boolean is
  370.      Xv_Rc : Xv_Object;
  371.   begin
  372.      Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_INSERT_FROM_FILE,Status'Access,
  373.              Interfaces.C.To_C(File_Name,True),0);
  374.      if Status = 0 then 
  375.     return True;
  376.      else
  377.     return False;
  378.      end if;
  379.   end Insert_File;
  380.  
  381. -----------------------------------------------------------------------------
  382.  
  383.   procedure Set_Line_Break (V : in Xv_Textsw; State : Boolean) is
  384.      Xv_Rc : Xv_Object;
  385.   begin
  386.      if State = True then
  387.     Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_LINE_BREAK_ACTION,Integer(5),0);
  388.      else
  389.     Xv_Rc := Xv_Set(Xv_Opaque(V.Base),TEXTSW_LINE_BREAK_ACTION,Integer(6),0);
  390.      end if;
  391.   end Set_Line_Break;
  392.  
  393. -----------------------------------------------------------------------------
  394.  
  395.   procedure Scroll_Line (V : in Xv_Textsw; Lines: Integer) is
  396.      procedure Textsw_Scroll_Lines (Obj : Textsw; Lines : Integer);
  397.      pragma Import (C,Textsw_Scroll_Lines,"textsw_scroll_lines");
  398.   begin
  399.      Textsw_Scroll_Lines(V.Base,Lines);
  400.   end Scroll_Line;
  401.  
  402. -----------------------------------------------------------------------------
  403.  
  404.   function Get_Screen_Lines (V : in Xv_Textsw) return Integer is
  405.      function Textsw_Screen_Line_Count (Obj : Textsw) return Integer;
  406.      pragma Import (C,Textsw_Screen_Line_Count,"textsw_screen_line_count");
  407.   begin
  408.      return Textsw_Screen_Line_Count(V.Base);
  409.   end Get_Screen_Lines;
  410.  
  411. -----------------------------------------------------------------------------
  412.  
  413.   procedure Get_Visible_File_Lines (V : in Xv_Textsw; Top : in out Integer; 
  414.                     Bottom : in out Integer) is
  415.      procedure Textsw_File_Lines_Visible (Obj : Textsw; Top,bottom : Int_Ptr);
  416.      pragma Import (C,Textsw_File_Lines_visible,"textsw_file_lines_visible");
  417.   begin
  418.      Textsw_File_Lines_Visible(V.Base,Top_Value'access,Bottom_Value'access);
  419.  
  420.      Top := Top_Value;
  421.      Bottom := Bottom_Value;
  422.   end Get_Visible_File_Lines;
  423.  
  424. -----------------------------------------------------------------------------
  425.  
  426.   procedure Find_Text (V : in Xv_Textsw; Start : in out Textsw_Index; 
  427.                Finish : in out Textsw_Index; Txt : String) is
  428.      function Textsw_Find_Bytes (Obj : Textsw; Start, Finish : Int_Ptr;
  429.                   Txt : Interfaces.C.Char_Array;
  430.                   Buf_Len : Integer) return Integer;
  431.      pragma Import (C,Textsw_Find_Bytes,"textsw_find_bytes");
  432.  
  433.      Xv_Rc : Integer;
  434.   begin
  435.      Xv_Rc := Textsw_Find_Bytes(V.Base,Start_Value'access,Finish_Value'Access,
  436.                 Interfaces.C.To_C(Txt,True),Txt'Length);
  437.  
  438.      if Xv_Rc > -1 then
  439.     Start  := Textsw_Index(Start_Value);
  440.     Finish := Textsw_Index(Finish_Value);
  441.      else
  442.     Start  := -1;
  443.     Finish := -1;
  444.      end if;
  445.   end Find_Text;
  446. end Xv_Textsw_Package;
  447.